home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
create1a
/
frmanim.frm
< prev
next >
Wrap
Text File
|
1999-09-25
|
6KB
|
170 lines
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Form1"
ClientHeight = 2310
ClientLeft = 45
ClientTop = 330
ClientWidth = 2400
Icon = "frmAnim.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 154
ScaleMode = 3 'Pixel
ScaleWidth = 160
StartUpPosition = 3 'Windows Default
Begin VB.VScrollBar vscSpeed
Height = 2055
LargeChange = 25
Left = 2040
Max = -1
Min = -1000
TabIndex = 5
Top = 120
Value = -1
Width = 255
End
Begin VB.CommandButton cmdLoopType
Caption = "Alternate"
Height = 255
Index = 2
Left = 120
TabIndex = 4
Top = 1920
Width = 1815
End
Begin VB.CommandButton cmdLoopType
Caption = "&Reverse"
Height = 255
Index = 1
Left = 120
TabIndex = 3
Top = 1680
Width = 1815
End
Begin VB.CommandButton cmdLoopType
Caption = "&Forward"
Height = 255
Index = 0
Left = 120
TabIndex = 2
Top = 1440
Width = 1815
End
Begin VB.Timer tmrTime
Left = 120
Top = 120
End
Begin VB.PictureBox picAnim
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 1230
Left = 120
ScaleHeight = 82
ScaleMode = 3 'Pixel
ScaleWidth = 120
TabIndex = 1
Top = 120
Width = 1800
End
Begin VB.PictureBox picBuffer
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00C0C0FF&
BorderStyle = 0 'None
Height = 1230
Left = 120
Picture = "frmAnim.frx":000C
ScaleHeight = 82
ScaleMode = 3 'Pixel
ScaleWidth = 600
TabIndex = 0
Top = 2280
Visible = 0 'False
Width = 9000
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------------------------'
'Title : Project AnimLogo
'Author : Timothy Pew
'E-mail : lord_kirk@geocities.com
'Copyright ⌐ 1999
'----------------------------------------'
'This project demonstrates one way to
'create an animated logo, such as those
'seen in Netscape Navigator and Microsoft
'Internet Explorer.
'----------------------------------------'
'constant values for the direction of animation
Const cFORWARD = 0 'loops to first frame after completing final frame
Const cREVERSE = 1 'loops to final frame after completely first frame
Const cALTERNATE = 2 'reverses the order of animation when it completes the first or last frame
'variables
Dim LoopType As Integer 'type of animation to perform, uses one of the above constants
Dim Cnt As Integer 'counter variable to keep track of current frame
Dim Dir As Integer 'used to increment/decrement the frame count as needed
Private Sub cmdLoopType_Click(Index As Integer)
LoopType = Index 'sets the animation type
If LoopType = cREVERSE Then
Cnt = 4 'sets the starting frame
Dir = -1 'count frames backward
Else
Cnt = 0 'sets the starting frame
Dir = 1 'count frames forward
End If
'sets the font of button the corrisponds to the LoopType to bold &
'unbolds the other buttons
For x = cmdLoopType.LBound To cmdLoopType.ubound
If x = LoopType Then
cmdLoopType(x).FontBold = True
Else
cmdLoopType(x).FontBold = False
End If
Next x
picAnim.SetFocus 'this is to keep the buttons from having the &
'focus square for no reason other than that I think it looks sloppy
End Sub
Private Sub Form_Load()
Show 'avoid an error by making sure that form is displayed
'set the current loop type to alternate by programmatically clicking
'the "Alternate" button
cmdLoopType_Click cALTERNATE
'set the timer but changing the value of vscSpeed
'vscSpeed uses negative numbers to make the higher value on top
vscSpeed.Value = -200
End Sub
Private Sub tmrTime_Timer()
Cnt = Cnt + Dir 'increment/decrement Cnt as needed
Select Case LoopType
Case cFORWARD:
If Cnt > 4 Then Cnt = 0
Dir = 1 'makes sure that the direction is correct
Case cREVERSE:
If Cnt < 0 Then Cnt = 4
Dir = -1 'makes sure that the direction is correct
Case cALTERNATE:
'swaps direction
If (Cnt = 4) Or (Cnt = 0) Then Dir = -Dir
End Select
'draw the new frame
BitBlt picAnim.hDC, 0, 0, 120, 82, picBuffer.hDC, Cnt * 120, 0, SRCCOPY
End Sub
Private Sub vscSpeed_Change()
'set the timer value to the absolute value of vscSpeed
tmrTime.Interval = Abs(vscSpeed.Value)
'set the caption to display the current speed
Caption = "Speed = " & tmrTime.Interval
End Sub